home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
rpc161a1.arc
/
RPC-SUB3.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-04-13
|
22KB
|
367 lines
******************************************************************************
************************ RBBS-PC Protocol Controller *** RPC-SUB3.BAS ****
************************ Merge for RBBS-PC.BAS *********************
************************ By John Morris ******* 16-1A *******
******************************************************************************
62530 SUB GETMATTR STATIC
Q = SQ
B$ = LG$(10)
LINES.IN.MESSAGE = LINES.IN.MESSAGE.SAVE
S = SL
NON.STOP = NON.STOP.SAVE
MESSAGE.DIM.INDEX = MESSAGE.DIM.INDEX.SAVE
KILL.MESSAGE = FALSE
END SUB
' $SUBTITLE: 'PROTOCOL - check for external protocols'
' $PAGE
'
' SUBROUTINE NAME -- PROTOCOL
'
' PARAMETER MEANING
'
' INPUT PARAMETERS -- NONE
'
' OUTPUT PARAMETERS -- TRANSFER.OPTIONS$ FILE TRANSFER PROTOCOLS
' THAT ARE ALLOWED.
' DFLTXFER$ THE STRING FROM WHICH
' PROTOCOLS ARE SELECTED
' (USING 'INSTR')
' SELECT.CHAR$() PROT.STRNG$ IS BUILT FROM
' THESE CHARACTERS
' PROT.NAME$() PROTOCOL NAME FOR EACH
' PROTOCOL
' UPLOAD.BAT.FILE.NAME$() BATCH FILE USED TO UPLOAD
' FOR EACH PROTOCOL
' DOWNLOAD.BAT.FILE.NAME$() BATCH FILE USED TO DOWNLOAD
' FOR EACH PROTOCOL
' RUN.METHOD$() DETERMINES WHETHER TO USE
' THE SHELL OR EXIT-RBBS
' METHOD FOR EACH PROTOCOL
' SUCCESS.CHECK.METHOD$() WAY TO CHECK EACH TRANSFER
' FOR SUCCESS
' MODE$() DIFFERENT OPTIONS OR CONTROLS
' NEEDED FOR EACH PROTOCOL
' =1 RELIABLE.MODE NEEDED
' =2 DON'T PRINT # OF BLOCKS
' =3 BATCH TRANSFER ALLOWED
' =4 MODE 2 + ALLOW
' BATCH TRANSFER
' =5 MODE 2 + WRITE FAKE
' XFER REPORT
' =6 (NOT USED)
' =7 (NOT USED)
' =8 1k BLOCKS
' =9 MODE 1 + 1k BLOCKS
'
' SUBROUTINE PURPOSE -- TO DETERMINE WHICH EXTERNAL PROTOCOL'S ARE AVAILABLE
' AND BUILD TRANSFER.OPTION$ AND SEVERAL ARRAYS
' ACCORDINGLY
'
* ------[ first line different ]------
SUB PROTOCOL STATIC ' RPC16-1A
CLOSE 2 ' RPC16-1A
CALL OPENWORK("RBBSXFR" + NODE.ID$ + ".DEF") ' RPC16-1A ' RPC16-1A
PROTNUM = 2 ' RPC16-1A
DFLTXFER$ = "A" ' RPC16-1A
PROT.NAME$(1) = "Ascii" ' RPC16-1A
TRANSFER.OPTIONS$ = "A) Ascii, " ' RPC16-1A
IF NOT USE.EXTERNAL.XMODEM THEN _ ' RPC16-1A
PROT.NAME$(2) = "Xmodem" : _ ' RPC16-1A
PROT.NAME$(3) = "Xmodem/CRC" : _ ' RPC16-1A
TRANSFER.OPTIONS$ = TRANSFER.OPTIONS$ + _ ' RPC16-1A
"X) Xmodem, " + _ ' RPC16-1A
"C) Xmodem/CRC, " : _ ' RPC16-1A
DFLTXFER$ = DFLTXFER$ + "XC" : _ ' RPC16-1A
PROTNUM = 4 ' RPC16-1A
IF NOT USE.EXTERNAL.YMODEM THEN _ ' RPC16-1A
PROT.NAME$(4) = "Ymodem" : _ ' RPC16-1A
TRANSFER.OPTIONS$ = TRANSFER.OPTIONS$ + _ ' RPC16-1A
"Y) Ymodem, " : _ ' RPC16-1A
DFLTXFER$ = DFLTXFER$ + "Y" : _ ' RPC16-1A
PROTNUM = 5 ' RPC16-1A
WHILE NOT EOF(2) ' RPC16-1A
INPUT #2, SELECT.CHAR$(PROTNUM), _ ' RPC16-1A
PROT.NAME$(PROTNUM), _ ' RPC16-1A
UPLOAD.BAT.FILE.NAME$(PROTNUM), _ ' RPC16-1A
DOWNLOAD.BAT.FILE.NAME$(PROTNUM), _ ' RPC16-1A
RUN.METHOD$(PROTNUM), _ ' RPC16-1A
SUCCESS.CHECK.METHOD$(PROTNUM), _ ' RPC16-1A
MODE$(PROTNUM) ' RPC16-1A
IF INSTR("19",MODE$(PROTNUM)) AND NOT RELIABLE.MODE THEN GOTO 62610
IF (PROTNUM MOD 6) = 0 THEN _ ' RPC16-1A
TRANSFER.OPTIONS$ = TRANSFER.OPTIONS$ + RETURN.LINE.FEED$
TRANSFER.OPTIONS$ = TRANSFER.OPTIONS$ + SELECT.CHAR$(PROTNUM) + _
") " + PROT.NAME$(PROTNUM) + ", " ' RPC16-1A
DFLTXFER$ = DFLTXFER$ + SELECT.CHAR$(PROTNUM) ' RPC16-1A
IF INSTR(UPLOAD.BAT.FILE.NAME$(PROTNUM),".") = 0 THEN _ ' RPC16-1A
UPLOAD.BAT.FILE.NAME$(PROTNUM) = UPLOAD.BAT.FILE.NAME$(PROTNUM) + _
".BAT" ' RPC16-1A
IF INSTR(DOWNLOAD.BAT.FILE.NAME$(PROTNUM),".") = 0 THEN _ ' RPC16-1A
DOWNLOAD.BAT.FILE.NAME$(PROTNUM) = DOWNLOAD.BAT.FILE.NAME$(PROTNUM) + _
".BAT" ' RPC16-1A
PROTNUM = PROTNUM + 1 ' RPC16-1A
* DELETING old line(s)
62600
* INSERTING new line(s)
62610 WEND ' RPC16-1A
CLOSE 2 ' RPC16-1A
LAST.PROT.NUM = PROTNUM ' RPC16-1A
END SUB ' RPC16-1A
' $SUBTITLE: 'TRANSFER - subroutine for KERMIT, YMODEM, IMODEM & YMODEM'
' $PAGE
'
' SUBROUTINE NAME -- TRANSFER
'
' INPUT PARAMETERS -- PARAMETER MEANING
' TRANSFER.FUNCTION = 1 DOWNLOAD FILE TO USER
' = 2 UPLOAD FILE TO RBBS-PC
' FILE.NAME$ NAME OF FILE FOR TRANSFER
' COM.PORT$ NAME OF COMMUNICATIONS PORT
' TO BE USED BY KERMIT (COM1
' OR COM2)
' BPS = -1 FOR 300 BAUD
' = -2 FOR 450 BAUD
' = -3 FOR 1200 BAUD
' = -4 FOR 2400 BAUD
' = -5 FOR 4800 BAUD
' = -6 FOR 9600 BAUD
' = -7 FOR 19200 BAUD
' PCKERMIT.EXE.FILE$ FILE TO TRANSFER CONTROL TO
' FOR KERMIT PROTOCOL ON
' PROTOCOL.PATH$.
' QMXFER.COM.FILE$ FILE TO TRANSFER CONTROL TO
' FOR YMODEM, IMODEM OR
' YMODEMG PROTOCOLS.
' WXMODEM.COM.FILE$ FILE TO TRANSFER CONTROL TO
' FOR WXMODEM PROTOCOL ON
' PROTOCOL.PATH$
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- TO TRANSFER FILES USING KERMIT, YMODEM, IMODEM,
' YMODEMG OR WXMODEM PROTOCOL'S
'
* REPLACING old line(s) by new
62620 SUB TRANSFER STATIC
* ------[ first line different ]------
IF NOT PRIVATE.DOOR THEN _ ' RPC16-1A
IF TRANSFER.FUNCTION = 1 THEN _ ' RPC16-1A
XFER.FILE$ = DOWNLOAD.BAT.FILE.NAME$(FF) : _ ' RPC16-1A
B$ = " send of " _ ' RPC16-1A
ELSE XFER.FILE$ = UPLOAD.BAT.FILE.NAME$(FF) : _ ' RPC16-1A
B$ = " receive of " ' RPC16-1A
CALL QTPUT (PROT.NAME$(FF) + B$ + FILE.NAME.HOLD$ + " ready! <Ctrl X> Aborts",1)
CALL XFRETURN ' RPC16-1A
END SUB ' RPC16-1A
' $SUBTITLE: 'XFRETURN - subroutine to exit as a private door.'
' $PAGE
'
' SUBROUTINE NAME -- XFRETURN
'
' INPUT PARAMETERS -- PARAMETER MEANING
' TRANSFER.FUNCTION = 1 DOWNLOAD FILE TO USER
' = 2 UPLOAD FILE TO RBBS-PC
' = 3 USER REGISTRATION PGM
' B$ NAME OF FILE TO EXIT TO
' COM.PORT$ NAME OF COMMUNICATIONS PORT
' TO BE USED BY KERMIT (COM1
' OR COM2)
' BPS = -1 FOR 300 BAUD
' = -2 FOR 450 BAUD
' = -3 FOR 1200 BAUD
' = -4 FOR 2400 BAUD
' = -5 FOR 4800 BAUD
' = -6 FOR 9600 BAUD
' = -7 FOR 19200 BAUD
' QMXFER.COM.FILE$ FILE TO TRANSFER CONTROL TO
' FOR YMODEM, IMODEM OR
' YMODEMG PROTOCOLS.
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- TO TRANSFER CONTROL TO ANOTHER PROGRAM
'
SUB XFRETURN STATIC
EXEC.METHOD$ = RUN.METHOD$(FF) ' RPC16-1A
IF PRIVATE.DOOR THEN _ ' RPC16-1A
EXEC.METHOD$ = "N" ' RPC16-1A
IF NOT PRIVATE.DOOR THEN _ ' RPC16-1A
FAKERPTTYPE$ = MID$(DFLTXFER$,FF,1) : _ ' RPC16-1A
IF MODE$(FF) = "5" THEN _ ' RPC16-1A
CALL FAKEXRPT(FAKERPTTYPE$) ' RPC16-1A
IF EXEC.METHOD$ = "D" THEN _ ' RPC16-1A
CALL MODXFERSTRING(XFER.FILE$,SHELL.STRING$) : _ ' RPC16-1A
CLOSE 3 : _ ' RPC16-1A
OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1 : _ ' RPC16-1A
CALL DELAYIT(2) : _ ' RPC16-1A
DEF SEG = 0 : _ ' RPC16-1A
FOR X = 0 TO 7 : _ ' RPC16-1A
COM.PORT.ADDRESS(X) = PEEK(&H400 + X) : _ ' RPC16-1A
NEXT : _ ' RPC16-1A
DEF SEG : _ ' RPC16-1A
SHELL SHELL.STRING$ : _ ' RPC16-1A
CALL DELAYIT(2) : _ ' RPC16-1A
DEF SEG = 0 : _ ' RPC16-1A
FOR X = 0 TO 7 : _ ' RPC16-1A
POKE (&H400 + X), COM.PORT.ADDRESS(X) : _ ' RPC16-1A
NEXT : _ ' RPC16-1A
DEF SEG ' RPC16-1A
IF EXEC.METHOD$ = "E" THEN _ ' RPC16-1A
A$(1) = "COMMAND /C " + _ ' RPC16-1A
XFER.FILE$ + " " + _ ' RPC16-1A
TALK.TO.MODEM.AT$ + " " + _ ' RPC16-1A
RIGHT$(COM.PORT$,1) + " " + _ ' RPC16-1A
FILE.NAME$ + " " + _ ' RPC16-1A
MID$(BAUD.PARITY$,INSTR(BAUD.PARITY$,",") + 1,1) : _ ' RPC16-1A
A$(2) = RBBS.BAT$ : _ ' RPC16-1A
PRIVATE.DOOR = -1 : _ ' RPC16-1A
CALL QTPUT ("Exiting to External Program. BEGIN TRANSFER and Please be patient.",1) : _
LOCATE 25,1 : _ ' RPC16-1A
CALL LPRNT(CHR$(10),0) : _ ' RPC16-1A
CALL MEMORY(FF) : _ ' RPC16-1A
CALL RBBSEXIT(A$(),2) ' RPC16-1A
CALL LINE25 ' RPC16-1A
PARITY$ = MID$(",N,8,1,E,7,1",7 + 6 * EIGHT.BIT,6) ' RPC16-1A
IF NOT LOCAL.USER THEN _ ' RPC16-1A
CALL OPENCOM(TALK.TO.MODEM.AT$,PARITY$) : _ ' RPC16-1A
IF PRIVATE.DOOR THEN _ ' RPC16-1A
FOR X = 1 TO 20 : _ ' RPC16-1A
PRINT : _ ' RPC16-1A
NEXT X : _ ' RPC16-1A
CALL QTPUT ("Reloading RBBS-PC. Please be patient.",1) : _'RPC16-1A
CALL DELAYIT(2) : _ ' RPC16-1A
CALL REMEMBER(FF) ' RPC16-1A
CALL SKIPLINE(2) ' RPC16-1A
LOCATE 24,1 ' RPC16-1A
IF TRANSFER.FUNCTION = 2 THEN : _ ' RPC16-1A
CLS : _ ' RPC16-1A
CALL LINE25 ' RPC16-1A
* DELETING old line(s)
62622
62624
62626
62628
62629
62630
62631
* REPLACING old line(s) by new
62632 END SUB
* ------[ first line different ]------
' $SUBITLE: 'MODXFERSTRING - Modify string in .BAT file'
' $PAGE
'
' SUBROUTINE NAME -- MODXFERSTRING
'
' PARAMETER MEANING
'
' INPUT PARAMETERS -- XFERBATFILE$ .BAT FILE TO GET INFO
' FROM
' OUTPUT PARAMETERS -- SHELL.STRING$ STRING TO USE FOR SHELL
' METHOD
'
' SUBROUTINE PURPOSE -- TO OPEN A BATCH AND RETRIEVE THE STRING TO USE FOR
' THE SHELL METHOD OF TRANSFER FROM WITHIN RBBS-PC.
' THIS IS THE SAME BATCH FILE USED WHEN USING THE
' EXIT RBBS-PC METHOD OF TRANSFER
'
* INSERTING new line(s)
62640 SUB MODXFERSTRING(XFERBATFILE$,SHELL.STRING$) STATIC ' RPC16-1A
CLOSE 2 ' RPC16-1A
OPEN XFERBATFILE$ FOR INPUT AS #2 ' RPC16-1A
LINE INPUT #2, DUMMY$ ' RPC16-1A
LINE INPUT #2, STRING.TO.CHANGE$ ' RPC16-1A
CLOSE 2 ' RPC16-1A
BAUD.STRING$ = TALK.TO.MODEM.AT$ ' RPC16-1A
MODEM.PORT$ = RIGHT$(COM.PORT$,1) ' RPC16-1A
PARITY$ = MID$("NE",2 + 1 * EIGHT.BIT,1) ' RPC16-1A
BAUD.IN.STRING = INSTR(STRING.TO.CHANGE$,"%1") ' RPC16-1A
STRING1$ = MID$(STRING.TO.CHANGE$,1,BAUD.IN.STRING-1) ' RPC16-1A
STRING2$ = MID$(STRING.TO.CHANGE$,BAUD.IN.STRING + 2) ' RPC16-1A
STRING.TO.CHANGE$ = STRING1$ + BAUD.STRING$ + STRING2$ ' RPC16-1A
PORT.IN.STRING = INSTR(STRING.TO.CHANGE$,"%2") ' RPC16-1A
STRING1$ = MID$(STRING.TO.CHANGE$,1,PORT.IN.STRING-1) ' RPC16-1A
STRING2$ = MID$(STRING.TO.CHANGE$,PORT.IN.STRING + 2) ' RPC16-1A
STRING.TO.CHANGE$ = STRING1$ + MODEM.PORT$ + STRING2$ ' RPC16-1A
FILE.IN.STRING = INSTR(STRING.TO.CHANGE$,"%3") ' RPC16-1A
STRING1$ = MID$(STRING.TO.CHANGE$,1,FILE.IN.STRING-1) ' RPC16-1A
STRING2$ = MID$(STRING.TO.CHANGE$,FILE.IN.STRING + 2) ' RPC16-1A
STRING.TO.CHANGE$ = STRING1$ + FILE.NAME$ + STRING2$ ' RPC16-1A
PRTY.IN.STRING = INSTR(STRING.TO.CHANGE$,"%4") ' RPC16-1A
IF PRTY.IN.STRING > 0 THEN _ ' RPC16-1A
STRING1$ = MID$(STRING.TO.CHANGE$,1,PRTY.IN.STRING-1) : _ ' RPC16-1A
STRING2$ = MID$(STRING.TO.CHANGE$,PRTY.IN.STRING + 2) : _ ' RPC16-1A
STRING.TO.CHANGE$ = STRING1$ + PARITY$ + STRING2$ ' RPC16-1A
NODE.IN.STRING = INSTR(STRING.TO.CHANGE$,"%5") ' RPC16-1A
IF NODE.IN.STRING > 0 THEN _ ' RPC16-1A
STRING1$ = MID$(STRING.TO.CHANGE$,1,NODE.IN.STRING-1) : _ ' RPC16-1A
STRING2$ = MID$(STRING.TO.CHANGE$,NODE.IN.STRING + 2) : _ ' RPC16-1A
STRING.TO.CHANGE$ = STRING1$ + NODE.ID$ + STRING2$ ' RPC16-1A
SHELL.STRING$ = STRING.TO.CHANGE$ ' RPC16-1A
END SUB ' RPC16-1A
' $SUBTITLE: 'MEMORY - "Memorize" FF before exiting RBBS-PC'
' $PAGE
'
' SUBROUTINE NAME -- MEMORY
'
' PARAMETER MEANING
'
' INPUT PARAMETERS -- FF NUMBER OF PROTOCOL USED
' FOR THIS TRANSFER
' OUTPUT PARAMETERS -- NONE
'
'
' SUBROUTINE PURPOSE -- WRITE "FF" TO A FILE SO IT CAN BE RETRIEVED AFTER
' USING THE EXIT RBBS-PC METHOD OF XFER THIS IS NEEDED
' FOR ANY NON-QMXFER TYPE OF PROTOCOL DRIVER
'
SUB MEMORY(FF) STATIC ' RPC16-1A
CLOSE 2 ' RPC16-1A
OPEN "XFER-" + NODE.ID$ + ".TMP" FOR OUTPUT AS #2 ' RPC16-1A
PRINT #2, FF ' RPC16-1A
PRINT #2, FILE.NAME$ ' RPC16-1A
PRINT #2, FILE.NAME.HOLD$ ' RPC16-1A
CLOSE 2 ' RPC16-1A
END SUB ' RPC16-1A
' $SUBTITLE: 'REMEMBER - Retrive FF after re-entering RBBS-PC'
' $PAGE
'
' SUBROUTINE NAME -- REMEMBER
'
' PARAMETER MEANING
'
' INPUT PARAMETERS -- NONE
'
' OUTPUT PARAMETERS -- FF NUMBER OF PROTOCOL USED
' FOR THE LAST TRANSFER
'
' SUBROUTINE PURPOSE -- RETRIVE "FF" FROM A FILE SO IT CAN BE USED AFTER
' RE-ENTERING RBBS-PC. THIS IS NEEDED FOR ANY
' NON-QMXFER TYPE OF PROTOCOL DRIVER
'
SUB REMEMBER(FF) STATIC ' RPC16-1A
CLOSE 2 ' RPC16-1A
CALL OPENWORK ("XFER-" + NODE.ID$ + ".TMP") ' RPC16-1A
INPUT #2, FF ' RPC16-1A
INPUT #2, FILE.NAME$ ' RPC16-1A
INPUT #2, FILE.NAME.HOLD$ ' RPC16-1A
CLOSE 2 ' RPC16-1A
END SUB ' RPC16-1A
' $SUBTITLE: 'FAKEXRPT - subroutine to create fake xfer report'
' $PAGE
'
' SUBROUTINE NAME -- FAKEXRPT
'
' INPUT PARAMETERS -- PARAMETER MEANING
' FILE.NAME.HOLD$ FILE TO BE TRANSFERRED
' PROTO.USED$ PROTOCOL USED
'
' OUTPUT PARAMETERS -- WRITES OUT TRANSFER FILE REPORT
'
' SUBROUTINE PURPOSE -- EXTERNAL PROTOCOL DRIVERS THAT DO NOT WRITE
' OUT A STANDARD TRANSFER REPORT MUST HAVE ONE
' PROVIDED IN ORDER FOR "DOORING" TO EXTERNAL
' PROTOCOLS TO WORK PROPERLY, SINCE THIS FILE
' IS READ UPON RETURNING FROM AN EXTERNAL PROTOCOL.
'
